home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / STRINGS.SWG / 0002_Case Translation unit.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1996-02-21  |  11.6 KB  |  298 lines
  1. {
  2.    ╔══════════════════════════════ X L A T ══════════════════════════════╗
  3.    ║                                                                     ║
  4.    ║         Case Translation Routines for Turbo/Borland Pascal          ║
  5.    ║                                                                     ║
  6.    ║                            Version 1.00                             ║
  7.    ║                                                                     ║
  8.    ║  Copyright (c) 1994, John O'Harrow F.I.A.P. - All Rights Reserved   ║
  9.    ║                                                                     ║
  10.    ║  This unit provides a library of very highly optimised routines     ║
  11.    ║  for the translating of strings into upper/lower case.              ║
  12.    ║                                                                     ║
  13.    ║  The majority of the routines are coded in assembler, and are       ║
  14.    ║  contained in the file XLAT.OBJ, which is linked into this unit.    ║
  15.    ║                                                                     ║
  16.    ║  The file XLAT.ASM contains the full source code for all of the     ║
  17.    ║  assembly code routines (This file is designed for assembling with  ║
  18.    ║  TASM, but may be assembled using MASM with minor modification).    ║
  19.    ║                                                                     ║
  20.    ╚═════════════════════════════════════════════════════════════════════╝
  21. }
  22. {$S-} {Disable Stack Checking to Increase Speed and Reduce Size}
  23.  
  24. UNIT XLAT;
  25.  
  26. {================================}INTERFACE{================================}
  27.  
  28. TYPE
  29.   XlatTable = ARRAY[Char] OF Char;
  30.  
  31. VAR
  32.   Upper, Lower : XlatTable;
  33.  
  34.   {These case translation tables are initialised according to the }
  35.   {country code information as specified in CONFIG.SYS (DOS 4.0+).}
  36.   {For older DOS versions, standard case conversion is used.      }
  37.   {These tables may also be accessed directly using, for example, }
  38.   {ResultChar := Upper['x'].  This provides the fastest possible  }
  39.   {replacement for the standard pascal Upcase() function.         }
  40.  
  41. {-String Case Conversion Procedures-----------------------------------------}
  42.  
  43.   PROCEDURE MakeUppercase(VAR S : String);
  44.   PROCEDURE MakeLowercase(VAR S : String);
  45.  
  46.   {These procedures should be used in preference to the equivalent}
  47.   {functions below where speed is critical (approx 50% faster).   }
  48.  
  49. {-String Case Conversion Functions------------------------------------------}
  50.  
  51.   FUNCTION  Uppercase(CONST S : String) : String;
  52.   FUNCTION  Lowercase(CONST S : String) : String;
  53.  
  54. {-General Purpose String Translation Procedure - ASCII/EBCDIC etc.----------}
  55.  
  56.   PROCEDURE Translate(VAR S : String; VAR Table : XlatTable);
  57.  
  58. {=============================}IMPLEMENTATION{==============================}
  59.  
  60. {$L XLAT}
  61.  
  62.   PROCEDURE MakeUppercase(VAR S : String); EXTERNAL;
  63.   PROCEDURE MakeLowercase(VAR S : String); EXTERNAL;
  64.  
  65.   FUNCTION  Uppercase(CONST S : String) : String; EXTERNAL;
  66.   FUNCTION  Lowercase(CONST S : String) : String; EXTERNAL;
  67.  
  68.   PROCEDURE Translate(VAR S : String; VAR Table : XlatTable); ASSEMBLER;
  69.   ASM
  70.     LES   DI,S        {ES:DI => S}
  71.     MOV   CL,ES:[DI]  {Get Length(S)}
  72.     AND   CX,00FFh    {CX = Length(S), ZF Set if Null String}
  73.     JZ    @@Finish    {Finished if S is a Null String}
  74.     MOV   DX,DS       {Save DS}
  75.     LDS   BX,Table    {DS:BX => Translation Table}
  76.     INC   DI          {ES:DI => S[1]}
  77.     TEST  DI,1        {Is ES:DI on a Word Boundary?}
  78.     JZ    @@Even      {Yes - Ok}
  79.     MOV   AL,ES:[DI]  {No  - Translate 1st Char}
  80.     XLAT
  81.     MOV   ES:[DI],AL
  82.     DEC   CX
  83.     INC   DI
  84.   @@Even:             {ES:DI now Alligned on a Word Boundary}
  85.     SHR   CX,1        {CX = Characters Pairs to Translate}
  86.     JZ    @@Last      {Skip if no Character Pairs}
  87.     PUSHF             {Save Carry Flag - Set of Odd Char Left}
  88.   @@Loop:
  89.     MOV   AX,ES:[DI]  {Translate Next 2 Characters}
  90.     XLAT
  91.     XCHG  AL,AH
  92.     XLAT
  93.     XCHG  AL,AH
  94.     MOV   ES:[DI],AX
  95.     ADD   DI,2
  96.     DEC   CX
  97.     JNZ   @@Loop      {Repeat for each Pair of Chars}
  98.     POPF              {Restore Carry Flag}
  99.   @@Last:
  100.     JNC   @@Done      {Finished if No Odd Char to Translate}
  101.     MOV   AL,ES:[DI]  {Translate Last Char}
  102.     XLAT
  103.     MOV   ES:[DI],AL
  104.   @@Done:
  105.     MOV   DS,DX       {Restore Saved DS}
  106.   @@Finish:
  107.   END; {Translate}
  108.  
  109. {=Non Interfaced Routines (Used in Unit Initialisation)=====================}
  110.  
  111.   FUNCTION DosMajorVersion : Byte;
  112.     {-Return DOS Major Version Number}
  113.   INLINE(
  114.     $B4/$30/    {mov ah,$30}
  115.     $CD/$21);   {int $21}
  116.  
  117.   PROCEDURE SetCountrySpecificUppercase;
  118.     {-Translate 'Upper' into its country specific uppercase equivalent}
  119.   INLINE(
  120.     $BA/>Upper/ {mov dx,Upper}
  121.     $B9/>256/   {mov cx,256}
  122.     $B8/>$6521/ {mov ax,$6521}
  123.     $CD/$21);   {int $21}
  124.  
  125.   PROCEDURE InitialiseCaseConversion;
  126.   VAR
  127.     C : Char;
  128.   BEGIN
  129.     ASM {Fast/Small Replacement for:- FOR C := #0 TO #255 DO Upper[C] := C;}
  130.       MOV SI,Offset Upper
  131.       XOR BX,BX
  132.     @@Loop:
  133.       MOV [SI+BX],BL
  134.       INC BL
  135.       JNZ @@Loop
  136.     END;
  137.     IF DosMajorVersion < 4 THEN
  138.       FOR C := #0 TO #255 DO
  139.         Upper[C] := System.UpCase(C) {Use Standard Case Conversion}
  140.     ELSE
  141.       SetCountrySpecificUppercase; {Use International Case Conversion}
  142.     FOR C := #255 DOWNTO #0 DO
  143.       IF C <> Upper[C] THEN {Set Lowercase conversion Table from Uppercase}
  144.         Lower[Upper[C]] := C;
  145.   END; {InitialiseCaseConversion}
  146.  
  147. {=Unit Initialisation=======================================================}
  148.  
  149. BEGIN
  150.   InitialiseCaseConversion;
  151. END.
  152.  
  153. {XLAT.ASM (Cut here and Assemble using TASM) -------------------------------}
  154.  
  155.           .MODEL TPASCAL
  156.  
  157.           LOCALS @@
  158.  
  159.           EXTRN  Upper ;ARRAY[Char] OF Char (Uppercase Translation Table)
  160.           EXTRN  Lower ;ARRAY[Char] OF Char (Lowercase Translation Table)
  161.  
  162.           .CODE
  163.  
  164.           .8086
  165.  
  166.           PUBLIC MakeUppercase, Uppercase
  167.           PUBLIC MakeLowercase, Lowercase
  168.  
  169. ;----------------------------------------------------------------------------
  170. ;PROCEDURE MakeLowercase(VAR S : String);
  171. ;----------------------------------------------------------------------------
  172. MakeLowercase PROC FAR
  173.           MOV   AX,Offset Lower  ;Select Case Table
  174.           JMP   SHORT CaseProc
  175. MakeLowercase ENDP
  176.  
  177. ;----------------------------------------------------------------------------
  178. ;PROCEDURE MakeUppercase(VAR S : String);
  179. ;----------------------------------------------------------------------------
  180. MakeUppercase PROC FAR
  181.           MOV   AX,Offset Upper  ;Select Case Table and Drop into CaseProc
  182. MakeUppercase ENDP
  183.  
  184. ;----------------------------------------------------------------------------
  185. ;Translate String using conversion table at Offset AX in Data Segment
  186. ;----------------------------------------------------------------------------
  187. CaseProc  PROC  FAR
  188.           MOV   BX,SP
  189.           LES   DI,SS:[BX+4]     ;ES:DI => String
  190.           MOV   CL,ES:[DI]       ;CL = Length(S)
  191.           AND   CX,00FFh         ;CX = Length(S)
  192.           JZ    @@Done           ;Done if Null String
  193.           MOV   BX,AX            ;DS:BX => Translation Table
  194.           INC   DI               ;ES:DI => S[1]
  195.           JMP   SHORT Translate  ;Exit Via Translate Procedure
  196. @@Done:   RET   4
  197. CaseProc  ENDP
  198.  
  199. ;----------------------------------------------------------------------------
  200. ;FUNCTION LowerCase(S : String) : String;
  201. ;----------------------------------------------------------------------------
  202. LowerCase PROC  FAR
  203.           MOV   AX,Offset Lower  ;Select Case Table
  204.           JMP   SHORT CaseFunc
  205. LowerCase ENDP
  206.  
  207. ;----------------------------------------------------------------------------
  208. ;FUNCTION UpperCase(S : String) : String;
  209. ;----------------------------------------------------------------------------
  210. UpperCase PROC  FAR
  211.           MOV   AX,Offset Upper  ;Select Case Table and Drop into CaseFunc
  212. UpperCase ENDP
  213.  
  214. ;----------------------------------------------------------------------------
  215. ;Translate String using conversion table at Offset AX in Data Segment
  216. ;----------------------------------------------------------------------------
  217. CaseFunc  PROC  FAR
  218.           MOV   DX,DS            ;Save DS
  219.           MOV   BX,SP
  220.           LDS   SI,SS:[BX+4]     ;DS:SI = String Address
  221.           LES   DI,SS:[BX+8]     ;ES:DI = Result Address
  222.           MOV   BX,AX            ;BX = Offset of Translation Table
  223.           CLD
  224.           LODSB                  ;Get String Length Byte
  225.           STOSB                  ;Store Result Length
  226.           AND   AX,00FFh         ;AX = Length(S)
  227.           JZ    @@Done           ;Exit if Null String
  228.           MOV   CX,AX            ;CX = Length(S)
  229.           PUSH  DI               ;Save Offset of Result[1]
  230.           TEST  DI,1             ;Destination Address Even?
  231.           JZ    @@CWord          ;Yes - Skip Odd Byte Move
  232.           MOVSB                  ;No - Move Odd Byte
  233.           DEC   CX               ;Decrement Count
  234. @@CWord:  SHR   CX,1             ;CX = Words to Copy, Set CF if Odd Byte Left
  235.           REP   MOVSW            ;Copy CX Words
  236.           JNC   @@Copied         ;Skip if No Odd Byte to Copy
  237.           MOVSB                  ;Copy the Odd Byte
  238. @@Copied: POP   DI               ;ES:DI => Result[1]
  239.           MOV   DS,DX            ;Restore DS, DS:BX => Translation Table
  240.           MOV   CX,AX            ;CX = String Length
  241.           JMP   SHORT Translate  ;Exit Via Translate Procedure
  242. @@Done:   RET   4
  243. CaseFunc  ENDP
  244.  
  245. ;----------------------------------------------------------------------------
  246. ;Translate CX Chars at ES:DI using XLAT Table as DS:BX (Common Exit Proc)
  247. ;----------------------------------------------------------------------------
  248. Translate PROC  FAR
  249.           TEST  DI,1             ;Is ES:DI on a Word Boundary?
  250.           JZ    @@Even           ;Yes - Ok
  251.           MOV   AL,ES:[DI]       ;No - Translate 1st Char
  252.           XLAT
  253.           MOV   ES:[DI],AL
  254.           DEC   CX
  255.           INC   DI               ;ES:DI now on a Word Boundary
  256. @@Even:   SHR   CX,1             ;CX = Characters Pairs to Translate
  257.           JZ    @@Last           ;No Character Pairs
  258.           PUSHF                  ;Save Flags - CF Set of Odd Char Left
  259. @@Loop:   MOV   AX,ES:[DI]       ;Translate Next 2 Characters
  260.           XLAT
  261.           XCHG  AL,AH
  262.           XLAT
  263.           XCHG  AL,AH
  264.           MOV   ES:[DI],AX
  265.           ADD   DI,2
  266.           DEC   CX
  267.           JNZ   @@Loop           ;Repeat for each Pair of Chars
  268.           POPF                   ;Restore CF
  269. @@Last:   JNC   @@Done           ;Finished if No Odd Char to Translate
  270.           MOV   AL,ES:[DI]       ;Translate Last Char
  271.           XLAT
  272.           MOV   ES:[DI],AL
  273. @@Done:   RET   4
  274. Translate ENDP
  275.  
  276.  
  277. CODE      ENDS
  278.           END
  279.  
  280. { --------------------------------------------------------------------- }
  281. { XX3402 for XLAT.OBJ
  282.  
  283.   Cut out and name file XLAT.XX.
  284.   Use XX3402 to decode the object file :   xx3402 d xlat.xx
  285. }
  286.  
  287. *XX3402-000403-190296--72--85-07771--------XLAT.OBJ--1-OF--1
  288. U+c+05VgMLEiEJBBdcUU++++53FpQa7j623nQqJhMalZQW+UJaJmQqZjPW+n9X8NW-++ECa5
  289. EZAU05VgMLEiEJBBAsU1+21dH7M0++-cW+A+E84IZUM+-2BDF2J3a+Q+86k++U2-eNM4++F2
  290. EJF-FdU5+2U+++A-+FGA1k+3JJ-EFJ6+-IlDJoJG+2OE3++++EpBEIh3JJ-EFJ71EJB3-E++
  291. Ut+E+++-0IlDJoJGEo3HFFw++78E2++++EZJI3-3IYB-IoIY++08Y-E+++2BHI39FIlDJoJG
  292. Eo3HFE+++6i6-+-+cU4Fc7+++E++i+++ukCs++09r1P2TkEaWUq-sTw+R+K9q2TfDQc2+9U+
  293. +Cg1i+++XBe9r1P3RkEql5w6WxXwf8cZzk-o4Mj6JzT5+E-o+eF7oSbndLA-d3yCqcj6ukD8
  294. -+1rlk2+R+YaWULL7cU3GITFuLEIb0O9-RS4lBS4l0O7-MD5+YZpvdpn-mO8-RQaW+L8-++F
  295. b-2+l+3K+gE4JU5263M0l0JK+Na8+U++R+++
  296. ***** END OF BLOCK 1 *****
  297.  
  298.